home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol076 / toxmod.for < prev    next >
Encoding:
Text File  |  1987-01-14  |  2.6 KB  |  115 lines
  1.  
  2.     program toxmodem
  3. c  convert VAX text file to
  4. c  file of XMODEM 128 byte records with embedded <CR><LF>
  5.  
  6.     character*254 line,input,output
  7.     character*1 CR,LF,c
  8.     integer blank
  9.     logical eof,eol
  10.     data eof,eol/.false.,.false./
  11.  
  12.     CR=char(13)
  13.     LF=char(10)
  14.     call lib$get_foreign(line,'$_From  To: ',)
  15.  
  16.     blank=index(line,' ')
  17.     input=line( 1:blank )
  18.     output=line( blank:)
  19.  
  20.     open(6,file=input,status='OLD')
  21.     open(7,file=output,status='NEW',carriagecontrol='LIST',
  22.     1                  recl=128,recordtype='FIXED')
  23.  
  24. c  getchar (read new line if no input characters left)
  25. c  putchar ( output record if full, close if EOF )
  26. c  if EOL on input, putchar CR putchar LF (output record if full)
  27. c  loop
  28.  
  29.   100    call getchar(c,eof,eol)
  30.     if(.not.eol) then
  31.         call putchar(c,eof)
  32.     else
  33. c  end of line
  34.         call putchar(CR,eof)
  35.         call putchar(LF,eof)
  36.         eol=.false.
  37.     endif
  38.     go to 100
  39.  
  40.       end
  41. c-------------------------------------------
  42.     subroutine getchar(inchar,eof,eol)
  43.     character*1 inchar
  44.     logical eof,eol
  45. c  get character from input line (read line if necessary)
  46. c  returns character and eol=.true. if no more char on line
  47. c  returns eof if end of file (no character)
  48.     character*255 line
  49.     integer len, pos
  50.     logical firsttime
  51.     common/lincom/pos,len,line
  52.     data pos/0/
  53.  
  54.     if(pos.eq.0) then
  55.         read(6,1000,end=100)len,line(1:len)
  56.  1000        format(q,a)
  57. c        print*,' line=',line
  58.     endif
  59.     pos=pos+1
  60.     if(pos.gt.len) then
  61.         eol=.true.
  62.         pos=0
  63.         return
  64.     endif
  65. c    print*,' pos=',pos,' line(1:pos)=',line(1:pos)
  66. c    print*,' line(pos:pos)=',line(pos:pos)
  67.     inchar=line(pos:pos)
  68. c    print*,' pos,char',pos,inchar
  69.     return
  70.  
  71. c  EOF
  72.   100    continue
  73.     eof=.true.
  74.     return
  75.     end
  76. c------------------------------------------
  77.     subroutine putchar(c,eof)
  78.     character*1 c
  79.     logical eof
  80. c  put character into record (write record if necessary)
  81. c  if eof, fills out rest of record with CTRL-Z's and exits
  82.     character*1 CTRLZ
  83.     character*128 record
  84.     integer point
  85.     common /reccom/point,record
  86.     data point/0/
  87.  
  88.     if(eof) goto 200
  89.     point=point+1
  90. c  strip parity in case VAX file had it
  91.     record(point:point)=char(iand(ichar(c),127))
  92. c    print*,' record(point:point)=',record(point:point)
  93. c    print*,' point=',point
  94.    50    if(point.ge.128) then
  95. c        print*,' record=',record
  96.   100        write(7,1000) record
  97.  1000        format(a)
  98.         point=0
  99.     endif
  100.     return        
  101.  
  102. c  EOF fill record with 26's (CTRL-Z, CP/M end of file mark for ASCII)
  103. c  output last record and exit
  104.   200    continue
  105. c    print*,' in putchar EOF section'
  106.     CTRLZ=char(26)
  107.     do i=point+1,128
  108.         record(i:i)=CTRLZ
  109.     enddo
  110. c    print*,' record=',record
  111.     write(7,1000) record
  112.     close(6)
  113.     close(7)
  114.     call exit
  115.     end
  116.